home *** CD-ROM | disk | FTP | other *** search
- ⓪ IMPLEMENTATION MODULE EventHandler;⓪ (*$L-, Y+*)⓪ ⓪ (* Implementation des 'EventHandler's der Megamax Modula-2 Biblothek⓪!*⓪!* geschrieben von Manuel Chakravarty Created: 9.9.87⓪!*⓪!* Version 2.2 V#0129⓪!*)⓪!⓪ (* 09.09.87 | Definitionen⓪!* 13.09.87 | 'InstallWatchDog' und 'DeInstallWatchDog' implementiert⓪!* 21.09.87 | 'commonHandler' und seine Benutzer impl.+ time/msgHdler⓪!* 22.09.87 | 'HandleEvents' impl.⓪!* 28.09.87 | Message-Install's lösen bei einem 'HandleEvents' jetzt⓪!* autom. eine Abfrage nach Message-Events aus, diese Eve-⓪!* nts werden falls nicht Abgefangen noch mal mittels⓪!* 'WriteToAppl' gesendet. 'ShareTime' impl.⓪!* 30.09.87 | SysInstall impl.⓪!* 07.11.87 | Anpassung an GEM V 0.10⓪!* 19.01.88 TT | levelCounter: deInstall korrgiert, searchList optimiert⓪!* 30.03.88 | 'HandleEvents' ruft jetzt bei Msg.events nur noch die⓪!* Proc's auf, die für den aufgetrettenen Msg.event-Typ⓪!* angemeldet sind (einzige Ausnahme 'unspecMessage').⓪!* 23.12.88 | 'ReadFromAppl' wird beim message add wirklich nur aufge-⓪!* rufen, falls die Nachricht länger als 16 Byte ist. Außerdem⓪!* wird des HIGH-Wert für die open arrays richtig übergeben.⓪!* 01.03.89 | *** Def-Änderung *** auf 2.00. Neu: 'FlushEvents'⓪!* 17.08.89 | 'KeyboardProc' um 'keys' erweitert⓪!* 15.02.90 | Anpassung an Compilerversion 4.0⓪!* 21.05.93 TT | Reentry bei ShareTime/FlushEvents verhindert.⓪!*)⓪ ⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, WORD,⓪7ADR;⓪ ⓪ FROM Storage IMPORT ALLOCATE, DEALLOCATE;⓪ ⓪ FROM PrgCtrl IMPORT EnvlpCarrier, TermCarrier,⓪7CatchProcessTerm, SetEnvelope;⓪ ⓪ FROM ResCtrl IMPORT RemovalCarrier,⓪7CatchRemoval;⓪ ⓪ FROM MOSGlobals IMPORT OutOfMemory, MemArea;⓪ ⓪ FROM GrafBase IMPORT Point, Rectangle,⓪7Rect;⓪2⓪ FROM GEMGlobals IMPORT GemChar, MButtonSet, SpecialKeySet;⓪4⓪ IMPORT GEMShare;⓪ ⓪ FROM GEMEnv IMPORT ApplicationID;⓪ ⓪ FROM AESEvents IMPORT unspecMessage, menuSelected, windRedraw, windTopped,⓪7windClosed, windFulled, windArrowed, windHSlid,⓪7windVSlid, windSized, windMoved, windNewTop, accOpen,⓪7accClose, Event, EventSet, ArrowedMode, MessageBuffer,⓪7RectEnterMode,⓪7MultiEvent;⓪ ⓪ FROM AESMisc IMPORT ReadFromAppl, WriteToAppl;⓪ ⓪ ⓪ ⓪ TYPE ptrCarrier =POINTER TO carrier;⓪(carrier =RECORD⓪;proc :PROC; (* Da Aufruf per JSR, sind *⓪R* die Param. egal. *)⓪;CASE (*messageEvent*):BOOLEAN OF⓪=FALSE : |⓪=TRUE : msgType:CARDINAL|⓪;END;⓪;next :ptrCarrier;⓪;level :INTEGER;⓪;(*future :LONGWORD;*)⓪9END;⓪9⓪ VAR keyboardList,buttonList,stRectList,⓪(ndRectList,messageList,timerList :ptrCarrier;⓪(⓪(watchDogExecuted: BOOLEAN; (* Semaphore between 'FlushEvents' and⓪D* the watch dog servers. *)⓪(flushExecuted : INTEGER; (* semaphore f. FlushEvents/ShareTime *)⓪(⓪(modLevel : INTEGER;⓪(⓪(voidI : INTEGER;⓪(⓪(⓪ (* commonHandler - Führt Handling für 'keyboard', 'mouseButton', 'firstRect'⓪!* 'secondRect' durch. 'data' sind die Daten, die⓪!* an die einzelnen Proc's als Parameter übergeben werden⓪!* sollen. 'list' ist die zu bearbeitende Proc-Liste.⓪!*)⓪ (*$J-*)⓪ PROCEDURE commonHandler(REF data: ARRAY OF WORD; list: ptrCarrier): BOOLEAN;⓪ (*$J=*)⓪ ⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0 ; 'list' -> A0⓪(MOVE.W -(A3),D1 ; HIGH(data) -> D1⓪(MOVE.L -(A3),A1 ; ADR(data) -> A1⓪(CMPA.L #NIL,A0⓪(BEQ endTRUE ; Leere List -> RETURN TRUE⓪(⓪(MOVE.W #TRUE, watchDogExecuted⓪ loop⓪(MOVE.W D1,D2 ; kopiere Param. auf A3-Stack⓪(MOVE.L A1,A2⓪ loop2⓪(MOVE.W (A2)+,(A3)+⓪(DBF D2,loop2⓪(MOVE.L carrier.proc(A0),A2 ; Hole Proceduraddresse⓪(MOVEM.L D1/A0-A1,-(A7)⓪(JSR (A2) ; und springe Userproc. an⓪(MOVEM.L (A7)+,D1/A0-A1⓪(MOVE.L carrier.next(A0),A0 ; hole Zeiger auf nächstes Listenelement⓪(CMPA.L #NIL,A0⓪(BEQ ende ; Listenende? => Fertig.⓪(TST.W -(A3)⓪(BNE loop ; Falls Userproc. keinen Abbruch wünscht weiter⓪(MOVE.W #FALSE,(A3)+⓪(BRA ende⓪(⓪ endTRUE⓪(MOVE.W #TRUE,(A3)+⓪ ende⓪$END;⓪"END commonHandler;⓪(⓪ (*$J-*)⓪ PROCEDURE keyboardHandler(VAR ch: GemChar; VAR keys: SpecialKeySet): BOOLEAN;⓪ (*$J=*)⓪ ⓪ CONST noParamB =8;⓪(noParamW =noParamB DIV 2 - 1; (* -1, da HIGH mit 0 beginnt *)⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(LEA -noParamB(A3),A0⓪(MOVE.L A0,(A3)+⓪(MOVE.W #noParamW,(A3)+⓪(MOVE.L keyboardList,(A3)+⓪(JSR commonHandler⓪(MOVE.W -(A3),D0⓪(SUBQ.L #noParamB,A3⓪(MOVE.W D0,(A3)+⓪"END;⓪ END keyboardHandler;⓪ ⓪ (*$J-*)⓪ PROCEDURE buttonHandler(clicks:CARDINAL;loc:Point;buts:MButtonSet;⓪8specials:SpecialKeySet):BOOLEAN;⓪ (*$J=*)⓪8⓪ CONST noParamB =10;⓪(noParamW =noParamB DIV 2 - 1;⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(LEA -noParamB(A3),A0⓪(MOVE.L A0,(A3)+⓪(MOVE.W #noParamW,(A3)+⓪(MOVE.L buttonList,(A3)+⓪(JSR commonHandler⓪(MOVE.W -(A3),D0⓪(SUBA.W #noParamB,A3⓪(MOVE.W D0,(A3)+⓪"END;⓪ END buttonHandler;⓪ ⓪ (*$J-*)⓪ PROCEDURE stRectHandler(loc:Point;buts:MButtonSet;⓪8specials:SpecialKeySet):BOOLEAN;⓪ (*$J=*)⓪ ⓪ CONST noParamB =8;⓪(noParamW =noParamB DIV 2 - 1;⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(LEA -noParamB(A3),A0⓪(MOVE.L A0,(A3)+⓪(MOVE.W #noParamW,(A3)+⓪(MOVE.L stRectList,(A3)+⓪(JSR commonHandler⓪(MOVE.W -(A3),D0⓪(SUBQ.L #noParamB,A3⓪(MOVE.W D0,(A3)+⓪"END;⓪ END stRectHandler;⓪ ⓪ (*$J-*)⓪ PROCEDURE ndRectHandler(loc:Point;buts:MButtonSet;⓪8specials:SpecialKeySet):BOOLEAN;⓪ (*$J=*)⓪ ⓪ CONST noParamB =8;⓪(noParamW =noParamB DIV 2 - 1;⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(LEA -noParamB(A3),A0⓪(MOVE.L A0,(A3)+⓪(MOVE.W #noParamW,(A3)+⓪(MOVE.L ndRectList,(A3)+⓪(JSR commonHandler⓪(MOVE.W -(A3),D0⓪(SUBQ.L #noParamB,A3⓪(MOVE.W D0,(A3)+⓪"END;⓪ END ndRectHandler;⓪ ⓪ (*$J-*)⓪ PROCEDURE messageHandler(msg:MessageBuffer):BOOLEAN;⓪ (*$J=*)⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(LEA -16(A3),A0 ; ADR(msg) -> A0⓪(MOVE.W (A0),D0 ; msg[0] (type of the message) -> D0⓪@; CASE msg[0] OF⓪(CMP.W #menuSelected,D0⓪(BEQ copy2⓪(CMP.W #windRedraw,D0⓪(BEQ copy5⓪(CMP.W #windTopped,D0⓪(BEQ copy1⓪(CMP.W #windClosed,D0⓪(BEQ copy1⓪(CMP.W #windFulled,D0⓪(BEQ copy1⓪(CMP.W #windArrowed,D0⓪(BEQ copy2⓪(CMP.W #windHSlid,D0⓪(BEQ copy2⓪(CMP.W #windVSlid,D0⓪(BEQ copy2⓪(CMP.W #windSized,D0⓪(BEQ copy5⓪(CMP.W #windMoved,D0⓪(BEQ copy5⓪(CMP.W #windNewTop,D0⓪(BEQ copy1⓪(CMP.W #accOpen,D0⓪(BEQ copy1from4⓪(CMP.W #accClose,D0⓪(BEQ copy1⓪(⓪(MOVEQ #unspecMessage,D0 ; keine message vom AES⓪(LEA (A0),A1⓪(MOVEQ #7,D1⓪(BRA cont⓪(⓪ copy1⓪(LEA 6(A0),A1 ; ab msg[3]⓪(MOVEQ #0,D1 ; 1 Wort⓪(BRA cont⓪(⓪ copy1from4⓪(LEA 8(A0),A1⓪(MOVEQ #0,D1⓪(BRA cont⓪(⓪ copy2⓪(LEA 6(A0),A1⓪(MOVEQ #1,D1⓪(BRA cont⓪ ⓪ copy5⓪(LEA 6(A0),A1⓪(MOVEQ #4,D1⓪(⓪ cont⓪(MOVEQ #TRUE,D2 ; init. momentanes Ergebnis⓪(MOVE.L messageList,A2⓪(⓪ loop⓪(CMPA.L #NIL,A2⓪(BEQ ende ; Falls Listenende, dann Fertig.⓪(CMP.W carrier.msgType(A2),D0⓪(BEQ typeMatch ; springe, falls Listenelem.typ = ges. Typ⓪(TST.W carrier.msgType(A2)⓪(BNE skipElem ; springe, falls Listenelem.typ # unspecMessage⓪(MOVEM.L D0-D1/A0-A2,-(A7)⓪(MOVE.L A0,A1 ; Kopierparam. für 'unspecMessage'⓪(MOVEQ #7,D1⓪(BRA loop2⓪(⓪ typeMatch⓪(MOVEM.L D0-D1/A0-A2,-(A7)⓪ loop2⓪(MOVE.W (A1)+,(A3)+ ; kopiere Param.⓪(DBF D1,loop2⓪(MOVE.L carrier.proc(A2),A2⓪(JSR (A2) ; springe Userproc. an⓪(MOVEM.L (A7)+,D0-D1/A0-A2⓪(MOVE.W -(A3),D2 ; neues momentanes Ergebnis -> D2⓪ skipElem⓪(MOVE.L carrier.next(A2),A2 ; nächstes Listenelem.⓪(TST.W D2⓪(BNE loop ; nochmal, falls momentanes Ergebnis # FALSE⓪(⓪(MOVE.W #TRUE, watchDogExecuted⓪ ende⓪(MOVE.L A0,A3 ; A3-Stack korrigieren⓪(MOVE.W D2,(A3)+ ; momentanes Ergebnis zurückgeben⓪"END;⓪ END messageHandler;⓪ ⓪ (*$J-*)⓪ PROCEDURE timerHandler():BOOLEAN;⓪ (*$J=*)⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(MOVE.L timerList,A0⓪(CMPA.L #NIL,A0⓪(BEQ endTRUE ; Leere List -> RETURN TRUE⓪(⓪ loop⓪(MOVE.L carrier.proc(A0),A2 ; Hole Proceduraddresse⓪(MOVE.L A0,-(A7)⓪(JSR (A2) ; und springe Userproc. an⓪(MOVE.L (A7)+,A0⓪(MOVE.L carrier.next(A0),A0 ; hole Zeiger auf nächstes Listenelement⓪(CMPA.L #NIL,A0⓪(BEQ ende ; Listenende? => Fertig.⓪(TST.W -(A3)⓪(BNE loop ; Falls Userproc. keinen Abbruch wünscht weiter⓪(MOVE.W #FALSE,(A3)+⓪(BRA ende⓪(⓪ endTRUE⓪(MOVE.W #TRUE,(A3)+⓪ ende⓪"END;⓪ END timerHandler;⓪ ⓪ ⓪ PROCEDURE InstallWatchDog(VAR handle:WatchDogCarrier;proc:EventProc);⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(MOVE.L -(A3),-(A7)⓪(MOVE.L -(A3),D0⓪(MOVE.W D0,-(A7)⓪(SWAP D0 ; 'proc.event' -> D0⓪(CMP.W #keyboard,D0 ; CASE proc.event OF⓪(BEQ installKey⓪(CMP.W #mouseButton,D0⓪(BEQ installBut⓪(CMP.W #firstRect,D0⓪(BEQ.W installSt⓪(CMP.W #secondRect,D0⓪(BEQ.W installNd⓪(CMP.W #message,D0⓪(BEQ.W installMsg⓪(CMP.W #timer,D0⓪(BEQ.W installTime⓪(TST.W (A7)+ ; an diesen Punkt kommt man theoretisch nie⓪(TST.L (A7)+⓪(BRA.W ende⓪(⓪ installKey ; install keyboard watch dog⓪(TST.L keyboardList⓪(BNE keyActive ; jump if 'keyboardList#NIL' (already plugged)⓪(LEA keyboardHandler,A0⓪(MOVE.L A0,keyboardPlug ; plug into the 'GEMshare.keyboardPlug'⓪(MOVE.W #TRUE,keyboardPlugActive⓪ keyActive⓪(MOVE.L -(A3),A0 ; ADR(handle) -> A0⓪(MOVE.W modLevel,carrier.level(A0)⓪(MOVE.L (A7)+,carrier.proc(A0) ; init. carrier and make it first⓪(TST.W (A7)+ ; element of the keyboard carrier list⓪(MOVE.L keyboardList,carrier.next(A0)⓪(MOVE.L A0,keyboardList⓪(BRA.W ende⓪(⓪ installBut ; install mouse button watch dog⓪(TST.L buttonList⓪(BNE butActive⓪(LEA buttonHandler,A0⓪(MOVE.L A0,buttonPlug⓪(MOVE.W #TRUE,buttonPlugActive⓪ butActive⓪(MOVE.L -(A3),A0⓪(MOVE.W modLevel,carrier.level(A0)⓪(MOVE.L (A7)+,carrier.proc(A0)⓪(TST.W (A7)+⓪(MOVE.L buttonList,carrier.next(A0)⓪(MOVE.L A0,buttonList⓪(BRA.W ende⓪(⓪ installSt⓪(TST.L stRectList⓪(BNE stActive⓪(LEA stRectHandler,A0⓪(MOVE.L A0,firstRectPlug⓪(MOVE.W #TRUE,firstRectPlugActive⓪ stActive⓪(MOVE.L -(A3),A0⓪(MOVE.W modLevel,carrier.level(A0)⓪(MOVE.L (A7)+,carrier.proc(A0)⓪(TST.W (A7)+⓪(MOVE.L stRectList,carrier.next(A0)⓪(MOVE.L A0,stRectList⓪(BRA.W ende⓪(⓪ installNd⓪(TST.L ndRectList⓪(BNE ndActive⓪(LEA ndRectHandler,A0⓪(MOVE.L A0,secondRectPlug⓪(MOVE.W #TRUE,secondRectPlugActive⓪ ndActive⓪(MOVE.L -(A3),A0⓪(MOVE.W modLevel,carrier.level(A0)⓪(MOVE.L (A7)+,carrier.proc(A0)⓪(TST.W (A7)+⓪(MOVE.L ndRectList,carrier.next(A0)⓪(MOVE.L A0,ndRectList⓪(BRA ende⓪(⓪ installMsg ; install message event watch dog⓪(TST.L messageList⓪(BNE msgActive ; already plugged ?⓪(LEA messageHandler,A0 ; if not plug in⓪(MOVE.L A0,messagePlug⓪(MOVE.W #TRUE,messagePlugActive⓪ msgActive⓪(MOVE.L -(A3),A0 ; ADR(handle) -> A0⓪(MOVE.W modLevel,carrier.level(A0)⓪(MOVE.W (A7)+,carrier.msgType(A0) ; save type of message event -> handle⓪(MOVE.L (A7)+,carrier.proc(A0) ; procedure address -> handle⓪(MOVE.L messageList,carrier.next(A0) ; insert into message list⓪(MOVE.L A0,messageList⓪(BRA ende⓪(⓪ installTime⓪(TST.L timerList⓪(BNE timeActive⓪(LEA timerHandler,A0⓪(MOVE.L A0,timerPlug⓪(MOVE.W #TRUE,timerPlugActive⓪ timeActive⓪(MOVE.L -(A3),A0⓪(MOVE.W modLevel,carrier.level(A0)⓪(MOVE.L (A7)+,carrier.proc(A0)⓪(TST.W (A7)+⓪(MOVE.L timerList,carrier.next(A0)⓪(MOVE.L A0,timerList⓪(⓪ ende⓪"END;⓪ END InstallWatchDog;⓪ ⓪ PROCEDURE SysInstallWatchDog(VAR handle:WatchDogCarrier;proc:EventProc);⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(MOVE.L -12(A3),-(A7)⓪(JSR InstallWatchDog⓪(MOVE.L (A7)+,A0⓪(CLR carrier.level(A0)⓪"END;⓪ END SysInstallWatchDog;⓪ ⓪ PROCEDURE DeInstallWatchDog(VAR handle:WatchDogCarrier);⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(MOVE.L -(A3),D1⓪(MOVEQ #5,D0 ; There are 5+1 lists⓪(PEA keyboardList⓪(PEA buttonList⓪(PEA ndRectList⓪(PEA stRectList⓪(PEA messageList⓪(PEA timerList⓪ loop⓪(MOVE.L (A7)+,A0⓪ loop2⓪(MOVE.L (A0),A1⓪(CMPA.L #NIL,A1⓪(BEQ listEnd⓪(CMP.L A1,D1⓪(BEQ foundHandle⓪(LEA carrier.next(A1),A0⓪(BRA loop2⓪ listEnd⓪(DBF D0,loop⓪(BRA ende ; handle was not installed⓪ ⓪ foundHandle⓪(LSL.W #2,D0 ; pop remaining list pointer from the stack⓪(ADDA.W D0,A7 ; A7:=A7+D0*4⓪(MOVE.L carrier.next(A1),(A0) ; delete 'handle' out of the list⓪(TST.L timerList⓪(BNE cont1⓪(CLR.W timerPlugActive⓪ cont1⓪(TST.L messageList⓪(BNE cont2⓪(CLR.W messagePlugActive⓪ cont2⓪(TST.L ndRectList⓪(BNE cont3⓪(CLR.W secondRectPlugActive⓪ cont3⓪(TST.L stRectList⓪(BNE cont4⓪(CLR.W firstRectPlugActive⓪ cont4⓪(TST.L buttonList⓪(BNE cont5⓪(CLR.W buttonPlugActive⓪ cont5⓪(TST.L keyboardList⓪(BNE ende⓪(CLR.W keyboardPlugActive⓪ ende⓪"END;⓪ END DeInstallWatchDog;⓪ ⓪ PROCEDURE HandleEvents ( noClicks : CARDINAL;⓪<butMask,⓪<butState : MButtonSet;⓪<moveDirec1: RectEnterMode;⓪<rect1Size : Rectangle;⓪<moveDirec2: RectEnterMode;⓪<rect2Size : Rectangle;⓪<time : LONGCARD;⓪8REF procs : ARRAY OF EventProc;⓪<usedProcs : CARDINAL);⓪8⓪ CONST procRecSize = 8; (* Länge des 'eventProc'-Typs *)⓪ ⓪ VAR msg : MessageBuffer;⓪(mouseLoc : Point;⓪(buttons : MButtonSet;⓪(keyState : SpecialKeySet;⓪(key : GemChar;⓪(doneClicks, i : CARDINAL;⓪(eventResult : EventSet;⓪(handlerResult : BOOLEAN;⓪(momEvent : Event;⓪(⓪(msgAdd : BOOLEAN;⓪(a7Store : LONGCARD;⓪7⓪ (*$L+*)⓪ BEGIN⓪"ASSEMBLER⓪8; last used index of 'procs' -> 'usedProcs' and D0⓪(MOVE.W usedProcs(A6),D0⓪(MOVE.W procs+4(A6),D1⓪(TST.W D0⓪(BEQ takeHigh⓪(SUBQ.W #1,D0⓪(CMP.W D0,D1⓪(BCC cont⓪ takeHigh⓪(MOVE.W D1,D0⓪ cont⓪(MOVE.W D0,usedProcs(A6)⓪8; Rufe MultiEvent auf, Ergebnis in 'eventResult'⓪(CLR.W D1 ; registrierte events⓪(MOVE.L procs(A6),A0⓪ loop1⓪(MOVE.W EventProc.event(A0),D2⓪(BSET D2,D1 ; registriere den gefundenen Event⓪(ADDQ.L #procRecSize,A0 ; nächstes Arrayelement⓪(DBF D0,loop1⓪<; Zusätzlich message event falls nötig⓪(CLR.W msgAdd(A6)⓪(BTST #message,D1⓪(BNE noMsgAdd ; message event schon gesetzt => springe⓪(TST.L messageList⓪(BEQ noMsgAdd ; message Liste leer => springe⓪(MOVE.W #TRUE,msgAdd(A6); message add erforderlich⓪(BSET #message,D1⓪ noMsgAdd⓪ ⓪(MOVE.B D1,(A3)+⓪(ADDQ.L #1, A3 ; possible events auf den Stack⓪(LEA noClicks(A6),A0⓪(MOVEQ #12,D0 ; 'noClicks' bis 'rect2Size' auf den Stack⓪ loop2⓪(MOVE.W (A0)+,(A3)+⓪(DBF D0,loop2⓪(LEA msg(A6),A0⓪(MOVE.L A0,(A3)+⓪(MOVE.L time(A6),(A3)+⓪(LEA mouseLoc(A6),A0⓪(MOVE.L A0,(A3)+⓪(LEA buttons(A6),A0⓪(MOVE.L A0,(A3)+⓪(LEA keyState(A6),A0⓪(MOVE.L A0,(A3)+⓪(LEA key(A6),A0⓪(MOVE.L A0,(A3)+⓪(LEA doneClicks(A6),A0⓪(MOVE.L A0,(A3)+⓪(LEA eventResult(A6),A0⓪(MOVE.L A0,(A3)+ ; 'eventResult' als VAR-Parameter⓪(JSR MultiEvent⓪(MOVE.B eventResult(A6),D0⓪(⓪8; beachte message add⓪(TST.W msgAdd(A6)⓪(BEQ.W noMsgAdd2⓪(BTST #message,D0⓪(BEQ.W noMsgAdd2⓪(BCLR #message,eventResult(A6)⓪(MOVEQ #0,D0⓪(MOVE.W msg+4(A6),D0⓪(ADD.L #16,D0 ; msg[2]+16 (Länge der message) -> D0⓪(MOVE.L A7,A0⓪(SUBA.L D0,A0⓪(SUBA.W #300,A0 ; 300 Byte Sicherheitszone für Stack⓪(CMPA.L A3,A0⓪(BCC enoughStack⓪(LEA a7Store(A6),A0⓪(MOVE.L A0,(A3)+⓪(MOVE.L D0,(A3)+⓪(JSR ALLOCATE⓪(MOVE.L a7Store(A6),A0 ; ADR(buffer) -> A0⓪(CLR.L a7Store(A6) ; Bedeutet: Benötigter Speicher nicht vom Stack⓪(CMPA.L #NIL,A0⓪(BNE allocOk⓪(TRAP #noErrorTrap⓪(DC.W OutOfMemory⓪(BRA.W noMsgAdd2⓪ enoughStack⓪(MOVE.L A7,a7Store(A6)⓪(SUBA.L D0,A7⓪(MOVE.L A7,A0 ; ADR(buffer) -> A0⓪ allocOk⓪(MOVE.L msg(A6),(A0)⓪(MOVE.L msg+4(A6),4(A0)⓪(MOVE.L msg+8(A6),8(A0)⓪(MOVE.L msg+12(A6),12(A0)⓪(⓪(MOVE.L A0,-(A7)⓪(TST.W msg+4(A6)⓪(BEQ noReadFromAppl⓪(⓪(JSR ApplicationID⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,D0⓪(ADD.L #16,D0⓪(MOVE.L D0,(A3)+⓪(MOVE.W msg+4(A6),(A3)+⓪(SUBQ.W #1,-2(A3) ; HIGH-Value is "no. elem.s" - 1⓪(CLR.W (A3)+⓪(MOVE.L A0,-(A7)⓪(JSR ReadFromAppl ; ReadFromAppl(Appl...ID(),buffer[16..],0)⓪ ⓪ noReadFromAppl⓪(JSR ApplicationID⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,(A3)+⓪(MOVE.W msg+4(A6),D0⓪(ADD.W #16,D0⓪(MOVE.W D0,(A3)+⓪(SUBQ.W #1,-2(A3) ; HIGH-Value is "no. elem.s" - 1⓪(CLR.W (A3)+⓪(MOVE.L A0,-(A7)⓪(JSR WriteToAppl ; WriteToAppl(ApplicationID(),buffer,0)⓪(MOVE.L (A7)+,A0⓪(⓪(MOVE.L a7Store(A6),D0⓪(BEQ dealloc⓪(MOVE.L D0,A7⓪(BRA noMsgAdd2⓪ dealloc⓪(MOVE.L A0,(A3)+⓪(CLR.L (A3)+⓪(JSR DEALLOCATE⓪ noMsgAdd2⓪@; call procs⓪(CLR.W i(A6)⓪ loop3⓪(MOVE.W i(A6),D0⓪(MOVE.W usedProcs(A6),D1⓪(CMP.W D0,D1⓪(BCS.W ende⓪(MOVEQ #0,D2⓪(MOVE.B eventResult(A6),D2 ; eventResult -> D2⓪(BEQ.W ende⓪(MOVE.W D0,D1⓪(MULU #procRecSize,D1⓪(MOVE.L procs(A6),A0⓪(ADDA.W D1,A0⓪(MOVE.W EventProc.event(A0),D1 ; proc[i].event -> D1⓪(MOVE.W D1,momEvent(A6) ; momEvent:=proc[i].event⓪(BTST D1,D2⓪(BEQ.W noMatch⓪(MOVE.L 2(A0),A1 ; proc[i].proc -> A1 (proc[i].event#message)⓪(CMP.W #keyboard,D1⓪(BEQ keyCall⓪(CMP.W #mouseButton,D1⓪(BEQ butCall⓪(CMP.W #firstRect,D1⓪(BEQ stRCall⓪(CMP.W #secondRect,D1⓪(BEQ ndRCall⓪(CMP.W #message,D1⓪(BEQ msgCall⓪(CMP.W #timer,D1⓪(BEQ.W tmrCall⓪(BRA.W noMatch⓪ keyCall⓪(LEA key(A6),A0⓪(MOVE.L A0,(A3)+⓪(LEA keyState(A6),A0⓪(MOVE.L A0,(A3)+⓪(JSR (A1)⓪(BRA.W caseEnd⓪ butCall⓪(MOVE.W doneClicks(A6),(A3)+⓪(MOVE.L mouseLoc(A6),(A3)+⓪(MOVE.B buttons(A6),(A3)+⓪(ADDQ.L #1, A3⓪(MOVE.B keyState(A6),(A3)+⓪(ADDQ.L #1, A3⓪(JSR (A1)⓪(BRA.W caseEnd⓪ stRCall⓪ ndRCall⓪(MOVE.L mouseLoc(A6),(A3)+⓪(MOVE.B buttons(A6),(A3)+⓪(ADDQ.L #1, A3⓪(MOVE.B keyState(A6),(A3)+⓪(ADDQ.L #1, A3⓪(JSR (A1)⓪(BRA.W caseEnd⓪ ⓪ msgCall ; in A0 ist noch ADR(proc[i])⓪(MOVE.W EventProc.msgType(A0),D1⓪(⓪(; Ist die Proc. vom Typ 'uspecMessage', so bekommt sie den Msg.event⓪(; sowieso, egal von welchem Typ er ist.⓪(⓪(CMP.W #unspecMessage,D1⓪(BEQ copy8from0⓪(⓪(; Sonst, muß der Typ des Msg.events gleich dem Typ sein, für den die⓪(; Proc. angemeldet ist.⓪(⓪(CMP.W msg(A6),D1 ; Proc-Typ = Event-Typ ?⓪(BNE.W noMatch ; Nein! => Kein Aufruf der Proc.⓪(⓪(CMP.W #menuSelected,D1⓪(BEQ copy2⓪(CMP.W #windRedraw,D1⓪(BEQ copy5⓪(CMP.W #windTopped,D1⓪(BEQ copy1⓪(CMP.W #windClosed,D1⓪(BEQ copy1⓪(CMP.W #windFulled,D1⓪(BEQ copy1⓪(CMP.W #windArrowed,D1⓪(BEQ copy2⓪(CMP.W #windHSlid,D1⓪(BEQ copy2⓪(CMP.W #windVSlid,D1⓪(BEQ copy2⓪(CMP.W #windSized,D1⓪(BEQ copy5⓪(CMP.W #windMoved,D1⓪(BEQ copy5⓪(CMP.W #windNewTop,D1⓪(BEQ copy1⓪(CMP.W #accOpen,D1⓪(BEQ copy1from4⓪(CMP.W #accClose,D1⓪(BEQ copy1⓪(BRA.W noMatch⓪'⓪ copy8from0⓪(LEA msg(A6),A2⓪(MOVEQ #7,D1⓪(BRA doIt⓪(⓪ copy1⓪(LEA msg+6(A6),A2 ; ab msg[3]⓪(MOVEQ #0,D1 ; 1 Wort⓪(BRA doIt⓪(⓪ copy1from4⓪(LEA msg+8(A6),A2⓪(MOVEQ #0,D1⓪(BRA doIt⓪(⓪ copy2⓪(LEA msg+6(A6),A2⓪(MOVEQ #1,D1⓪(BRA doIt⓪ ⓪ copy5⓪(LEA msg+6(A6),A2⓪(MOVEQ #4,D1⓪ doIt⓪(MOVE.L 4(A0),A1 ; proc[i].proc -> A1⓪ copyLoop⓪(MOVE.W (A2)+,(A3)+⓪(DBF D1,copyLoop⓪(JSR (A1)⓪(BRA.W caseEnd⓪ tmrCall⓪(JSR (A1)⓪ caseEnd⓪(TST.W -(A3)⓪(BNE noMatch⓪(MOVE.W momEvent(A6),D0⓪(BCLR D0,eventResult(A6)⓪ noMatch⓪(ADDQ.W #1,i(A6)⓪(BRA.W loop3⓪ ende⓪"END;⓪ END HandleEvents;⓪ (*$L=*)⓪ ⓪ ⓪ (*$L+*)⓪ ⓪ (*$J-*)⓪ PROCEDURE dummy (): BOOLEAN;⓪ (*$J=*)⓪ ⓪"BEGIN⓪$RETURN TRUE;⓪"END dummy;⓪ ⓪ PROCEDURE ShareTime (time: LONGCARD);⓪"⓪"VAR theProc: EventProc;⓪"⓪"BEGIN⓪$IF flushExecuted <= 2 THEN (* erlaubt 2 Rekursionslevel *)⓪&INC (flushExecuted);⓪&theProc.event := timer;⓪&theProc.timeHdler := dummy;⓪&HandleEvents(0, MButtonSet{}, MButtonSet{},⓪3lookForEntry, Rect(0,0,0,0), lookForEntry, Rect(0,0,0,0),⓪3time, theProc, 0);⓪&DEC (flushExecuted);⓪$END⓪"END ShareTime;⓪ ⓪ PROCEDURE FlushEvents;⓪ ⓪"BEGIN⓪&REPEAT⓪(watchDogExecuted := FALSE;⓪(ShareTime (0L);⓪&UNTIL NOT watchDogExecuted;⓪"END FlushEvents;⓪"⓪ ⓪8(* misc. managment *)⓪8(* =============== *)⓪ ⓪ PROCEDURE levelCounter(start,child:BOOLEAN; VAR id:INTEGER);⓪ ⓪"PROCEDURE searchList(list:ptrCarrier);⓪"⓪$VAR nlist: ptrCarrier;⓪"⓪$BEGIN⓪&WHILE list # NIL DO⓪(nlist:=list^.next;⓪(IF list^.level>=modLevel THEN⓪*ASSEMBLER⓪,MOVE.L list(A6),(A3)+⓪,JSR DeInstallWatchDog⓪*END⓪(END;⓪(list:= nlist⓪&END⓪$END searchList;⓪"⓪"BEGIN⓪$IF child THEN⓪&IF start THEN INC(modLevel)⓪&ELSE⓪(searchList(keyboardList);⓪(searchList(buttonList);⓪(searchList(stRectList);⓪(searchList(ndRectList);⓪(searchList(messageList);⓪(searchList(timerList);⓪(DEC(modLevel);⓪&END;⓪$END;⓪"END levelCounter;⓪ ⓪ PROCEDURE termProc;⓪ ⓪"BEGIN⓪$levelCounter(FALSE,TRUE, voidI);⓪"END termProc;⓪ ⓪ PROCEDURE removalProc;⓪"⓪"BEGIN⓪$(* Current 'modID = 0'. That means all init.s are released.⓪%*)⓪$levelCounter (FALSE, TRUE, voidI);⓪"END removalProc;⓪"⓪ VAR envlpHdl : EnvlpCarrier;⓪(termHdl : TermCarrier;⓪(removalHdl : RemovalCarrier;⓪(wsp : MemArea;⓪ ⓪ ⓪ BEGIN⓪"keyboardList := NIL;⓪"buttonList := NIL;⓪"stRectList := NIL;⓪"ndRectList := NIL;⓪"messageList := NIL;⓪"timerList := NIL;⓪"⓪"modLevel := 1;⓪"CatchProcessTerm (termHdl, termProc, wsp);⓪"SetEnvelope (envlpHdl, levelCounter, wsp);⓪"CatchRemoval (removalHdl, removalProc, wsp);⓪ END EventHandler.⓪ ə
- (* $FFF7C95C$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$000051E4$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416E$FFF8416EÇ$0000516E........T.......T......TT.......T.......T.......T.......T.......T.......T.......$00000B9B$0000515E$00005170$0000519D$0000516E$0000519D$000051AF$00005198$FFEEDCC0$0000527D$00005268$00005195$00005170$000005FA$000000D8$FFEEDCC0œÇâ*)
-
